perm filename DRAW2.OLD[DRW,LCS] blob
sn#449477 filedate 1979-06-10 generic text, type T, neo UTF8
C***** FOLLOWING IS FILE 'DRAW.CMD' **********
C*** DRAW[DRW,LCS],MSSIO[NEW,LCS],CB[DRW,LCS]
C*** ,DRAWSM[DRW,LCS],DPYIT[DRW,LCS],DREDIT[DRW,LCS],FILLER[DRW,LCS]
C*** ,CURSOR[MSS,LCS],SUBSLM[DRW,LCS]
C 'G' OR <CR> = GET. 'A'=ADD TO COMBINED FILE.
C PC=PLOT PX=XGP(→PLOT.BIN) PXS,PCS=PLOT SMOOTHED CONTURE
C PXZ,PCZ=PLOT SMOOTHED CONTURE AND FILL IT.
C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
C F=JUMP AND BEGIN FILL SECTION. FX=EXIT AND FILL ALL.
C SINGLE ITEM IS RESTRICTED TO 350 WDS. 10 ITEMS OR 350 WDS PER FILE.
C 'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
COMMON /RC/MCLEF(400),IST(4000)
COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
COMMON/ZN/SCLEF(400,2),DDD /ED/KED,NEXT,NN,NX,NY,J
COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
DIMENSION JCLEF(10),KCLEF(10),NMLST(10),JST(1)
COMMON/NFF/NF(513) /LL/LL /RZ/RSZ,IPLT,RJB,CENTR
COMMON/LETS/LETS(12)
EQUIVALENCE (MM,SCLEF(1,1)),(JCLEF,IST(1490)),(NM,IXRX)
1 ,(GRID,IST(4000)),(KCLEF,IST(1500))
2 ,(NMLST,IST(1510)),(JST,IST(500))
3,(LETS(1),LG),(LETS(2),LS),(LETS(3),LM),(LETS(4),LD)
4,(LETS(5),LR),(LETS(6),LP),(LETS(7),LA),(LETS(8),LF)
5,(LETS(9),LE),(LETS(10),LZ),(LETS(11),LQ),(LETS(12),LC)
DATA LETS/'G','S','M','D','R','P','A','F','E','Z',
1'Q','C'/
DATA RJB/-20./,CENTR/-26./
RSZ=0
10 MCLEF(1)=0
MM=0
IPLT=0
IPLTX=-1
K=1
20 TYPE 490
30 FORMAT(I,2F)
40 FORMAT(3A1)
XSZ=RSZ
ACCEPT 30,J,RSZ,GRID
IF(RSZ.EQ.0)RSZ=XSZ
MORE=-1
REREAD 40,N,JC,JS
IF(RSZ.EQ.0)RSZ=9.0
IF(GRID.NE.0.AND.N.NE.'P')CALL GRIDS
DO 50 K=1,12
C G S M D R P A F E Z
50 IF(LETS(K).EQ.N)GO TO(140,140,120,80,120,140,110,390,90,10,
1 100)K
C Q
IF(N.NE.' ')TYPE 60
GO TO 40
60 FORMAT(' UNKNOWN COMMAND'/)
C PXS,PCS=SMOOTH ONLY; PXZ,PCZ=SMOOTH AND FILL
C TO SAVE SIZE FACTOR WHEN REDRAWING.
70 IF(N.EQ.'V')CALL CNVT
C V=CONVERT FROM OLD FORMAT TO NEW.
C FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
C FILLS IT.
C 'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
80 IF(JS.NE.'L')GO TO 90
N='Z'
C DEL=DELETE FROM COMB. FILE. (JS='L')
GO TO 110
90 KED=N
MM=MCLEF(1)
IF(MM.NE.0)GO TO 500
C ADD TO DRAWING?
GO TO 330
100 CALL POG2
CALL RDRAW(2,MCLEF(1),MCLEF)
CALL DPYOUT(2)
CALL POG1
GO TO 20
110 CALL CMBN
CCC GO TO 111
GO TO 20
120 CALL SHIFT(MCLEF(2),MCLEF(1),N)
J=1
JC=0
GO TO 340
130 FORMAT(A2,A5)
140 REREAD 130,NM,NM
IF(JC.EQ.LM)NM=' '
IF(NM.NE.' ')GO TO 180
150 TYPE 520
IF(JC.EQ.'M')GO TO 160
IF(N.EQ.'S')GO TO 160
MCLEF(1)=0
MM=0
IPLTX=-1
K=1
160 IF(JC.EQ.'M')MORE=0
JQ=JC
JC=0
JM=1
IF(MCLEF(1).EQ.0)GO TO 170
JM=MCLEF(1)+1
170 ACCEPT 470,NM,PASS
IF(NM.EQ.' ')NM=LASTNM
IF(NM.EQ.' ')GO TO 20
IF(NM.EQ.'B'.OR.NM.EQ.'99')GO TO 20
C 'B' OR '99' WILL BACKUP
180 IF(N.NE.'S')LASTNM=NM
IF(N.EQ.'S')GO TO 530
IF(LOOKF(NM).EQ.0)GO TO 150
C 'FAIL' ROUTINE TO CHECK ON LOOKUP
CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
C -1=READ
C CAN'T USE 'GM' WITH 'COMBINED' FILE.
J=1
IF(KCLEF(2).EQ.0)GO TO 190
TYPE 230
ACCEPT 30,J
J=J+1
C ITEMS ARE NUMBERED 0 THROUGH 9 (10 ITEMS).
IF(J.GT.10)GO TO 50
190 IC=KCLEF(J)+JST(KCLEF(J))-1
CCC TYPE 110,IC
IF(IC.GT.350)TYPE 570
200 JZ=1
IF(MORE.EQ.0)JZ=JM
L=KCLEF(J)-1
M=JST(L+1)+JZ-1
IF(MORE.NE.0)GO TO 210
M=M-1
L=L+1
210 DO 220 K=JZ,M
L=L+1
220 MCLEF(K)=JST(L)
MCLEF(1)=M
230 FORMAT(' ITEM NUM?'/)
240 FORMAT(' RESET X-Y POS. ',$)
250 FORMAT(2F)
260 IF(MORE)GO TO 320
DO 270 K=2,JM-1
270 IF(MCLEF(K).GE.200000000)GO TO 280
GO TO 320
C PUTS FILLER TO END
C MOVES OUTLINE UP FRONT
280 M=MCLEF(1)
DO 290 L=K,JM
M=M+1
290 MCLEF(M)=MCLEF(L)
K=JM-K
300 DO 310 L=JM,M
310 MCLEF(L-K)=MCLEF(L)
GO TO 330
320 IF(N.NE.'P')GO TO 330
IXRX=-1
IF(JQ.NE.'X')IXRX=0
C 0=SEND IT TO CALCOMP
TYPE 240
ACCEPT 250,X,Y
IF(X.NE.0)RJB=X/RSZ
IF(Y.NE.0)CENTR=Y/RSZ
C TYPE .001, .001 TO SET POS. TO 0, -20, -26 IS ORIGINAL.
IF(IPLTX)CALL PLOTS(0)
C DO I NEED THIS?
IF(GRID.GT.0)CALL GRIDS
IPLTX=0
IPLT=-1
330 IF(N.NE.'D')MM=0
C RESET IF NOT GOING TO DRAWIT
340 IF(N.EQ.'P')GO TO 350
CALL DPYSET(1,IST,4000)
CALL DPYBRT(4)
NIST=IST(2)
IF(N.GE.0)GO TO 350
IF(N.EQ.'G')GO TO 350
IF(N.EQ.'M')GO TO 350
IF(N.NE.'R')GO TO 500
350 IF(JS.EQ.'Z')GO TO 400
IF(JS.NE.'S')GO TO 360
CALL SMOOTH(JS)
GO TO 430
360 IC=-1
MM=1
DO 370 K=2,MCLEF(1)
IF(MCLEF(K).LT.200000000)GO TO 370
IC=K
GO TO 380
C FOR 1ST LOC. OF MCLEF IN FILLER
370 CONTINUE
380 CALL RDRAW(2,MCLEF(1),MCLEF)
CALL DPYOUT(1)
NIST=IST(2)
GO TO 430
C NO FILLER
390 IF(IC)GO TO 20
C IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
JZ=N
KK=0
IF(JC.NE.'S')GO TO 410
C TYPE 'FS' TO FILL AND SMOOTH
400 CALL SMOOTH(0)
C SMOOTHS AND FILLS
GO TO 430
410 RR=RSZ
DO 420 J=IC,MCLEF(1)
CALL UNPACK(J,M,N,MCLEF)
KK=KK+1
NF(KK)=0
IF(LL.GE.100000000)NF(KK)=3
QF(KK)=(M+RJB)*RR
420 RF(KK)=(N+CENTR)*RR
NF(1)=KK
CALL FILLQ(QF,RF,NF)
430 IF(JZ.EQ.'P')CALL PLOT(0,0,3)
GO TO 20
440 TYPE 450,NM
GO TO 20
450 FORMAT(' MORE THAN ONE ITEM IN FILE ',A5/)
460 FORMAT(' SMOOTH? ',$)
470 FORMAT(A5,F)
480 FORMAT(12I)
490 FORMAT(' G=GET, GM=GET MORE, S=SAVE, D=DRAW, M=MOVE, R=ROTATE,'/'
1 P=PLOT, PX=XGP, A=ADD TO SAVED FILE
2, DEL=DEL. FROM FILE, Q=BACKGROUND, Z=ZERO DRAWING'/
3' F=FILL, E=EDIT, N1=SIZE, N2=1=GRID '/)
C N1=20 TO CHANGE SHAPE
500 IST(2)=NIST
CALL DRAWIT
N=0
GO TO 330
510 FORMAT(' WRITE OVER ',A5,'.DMD? ',$)
520 FORMAT(' TYPE FILE NAME'/)
C SAVES ONLY ONE PICTURE - USE 999(COMBINE) FOR UP TO 9
530 IF(LOOKF(NM).EQ.0)GO TO 540
TYPE 510,NM
ACCEPT 40,K
IF(K.EQ.'N')GO TO 50
540 NMLST(1)=NM
JCLEF(1)=1
DO 550 K=2,10
JCLEF(K)=0
550 NMLST(K)=' '
CALL RDSAV(JCLEF,NMLST,MCLEF(1),NM,MCLEF,0)
NQ=MCLEF(1)
CC111 TYPE 110,NQ
IF(NQ.GT.350)TYPE 570
GO TO 20
CC120 FORMAT(' 9999 1 ',I4,' 0 0 0 0 0 0 0 0')
560 FORMAT(' TOTAL WDS=',I3)
570 FORMAT(' ********************************',/
1 ' ***** WARNING - LIMIT=350 ******',/
2 ' ********************************')
END
SUBROUTINE CMBN
COMMON /RC/MCLEF(400),IST(4000)
COMMON /FL/NX,N,L,M,NM,J,NT
DIMENSION IP(10),NMS(10),NF(2500),JP(10),NMX(10)
EQUIVALENCE (IP,IST(3001)),(NMS,IST(3020)),(NF,IST(201))
1,(JP,IST(1500)),(NMX,IST(1510))
C ***** ****** **** ****** ↑ 20 FOR OVERRUN IN IP(11)
C USE FILE NAMES CLFX, DRAW1 AND DRAW2. 400 WD LIMIT PER FILE.
IF(N.EQ.'S')GO TO 170
10 TYPE 20
20 FORMAT(' TYPE OUTPUT FILE NAME ',$)
30 FORMAT(A5)
DO 40 K=1,10
IP(K)=0
40 NMS(K)=' '
ACCEPT 30,NM
IF(NM.NE.' ')GO TO 50
NM=LASTNM
TYPE 180,LASTNM
50 LASTNM=NM
IF(LOOKF(NM).EQ.0)GO TO 60
IF(N.NE.'C')GO TO 170
C FOR ADDING TO COMBINED FILE.
TYPE 120,NM
ACCEPT 30,NX
IF(NX.EQ.'N')GO TO 10
60 IF(N.EQ.'C')GO TO 70
TYPE 100
GO TO 10
70 L=0
NX=1
I=0
80 L=L+1
TYPE 90
90 FORMAT(' TYPE FILE NAME ',$)
ACCEPT 30,NW
IF(NW.EQ.' ')GO TO 130
IF(LOOKF(NW))GO TO 110
TYPE 100
GO TO 80
100 FORMAT(' FILE NOT FOUND'/)
110 I=I+1
IP(L)=NX
NMS(I)=NW
CALL RDSAV(JP,NMX,K,NW,MCLEF(NX),-2)
NX=NX+K
IF(L.LT.10)GO TO 80
120 FORMAT(' WRITE OVER ',A5,'.DMD? Y OR N? ',$)
130 NX=NX-1
140 CALL RDSAV(IP,NMS,NX,NM,MCLEF,0)
L=NX
RETURN
150 TYPE 160,ID
160 FORMAT(' FILE FULL -- SAVED AS ',A5)
L=1
NM=ID
NX=MCLEF(1)
GO TO 130
170 CALL RDSAV(IP,NMS,NX,NM,NF,-1)
180 FORMAT(1X,A5)
TYPE 190
190 FORMAT(' TYPE ID NAME (<CR>=BACKUP) -- ',$)
ACCEPT 30,ID
IF(ID.EQ.' ')GO TO 10
JD=0
L=0
CC NX=NX-1
DO 200 K=1,10
IF(NMS(K).EQ.ID)JD=K
IF(NMS(K).EQ.' ')GO TO 210
L=K
200 IF(JD.EQ.0.AND.K.EQ.10)GO TO 150
210 IF(N.EQ.'Z')GO TO 250
C FOR DELETIONS
L=L+1
IF(JD.NE.0)GO TO 260
C ADDS ON TO END
N=0
IP(L)=NX+1
DO 220 K=NX+1,MCLEF(1)+NX
N=N+1
220 NF(K)=MCLEF(N)
NX=NX+N
NMS(L)=ID
L=L+1
230 DO 240 K=1,NX
240 MCLEF(K)=NF(K)
C MOVES IT ALL TO MCLEF
GO TO 140
250 MCLEF(1)=0
260 N=IP(JD)
NR=MCLEF(1)
M=NF(IP(JD))
NW=NR-M
NX=NX+NW
IF(NW)270,310,280
270 JA=N+NR
JB=NX
JC=1
GO TO 290
280 JA=NX
JB=N+NW
JC=-1
290 DO 300 K=JA,JB,JC
300 NF(K)=NF(K-NW)
IF(NR.EQ.0)GO TO 340
310 DO 320 K=1,NR
NF(N)=MCLEF(K)
320 N=N+1
CC L=L-1
IF(NW.EQ.0)GO TO 230
DO 330 K=JD+1,L
330 IP(K)=IP(K)+NW
C FIXES UP FIRST LINE.
CC123 L=L-1
CC NX=NX-1
GO TO 230
340 IP(L+1)=0
CC L=L-1
DO 350 K=JD,L-1
IP(K)=IP(K+1)+NW
350 NMS(K)=NMS(K+1)
NMS(L)=' '
GO TO 230
END
SUBROUTINE RDSAV(KT,NMS,K,NAME,IO,L)
C POINTER LIST, NAME LIST, WDCNT, FILE NAME, DATA, RD OR WRT.
COMMON /RC/MCLEF(400),IST(4000)/FL/IC,NH,NQ,A,B,C,D
DIMENSION KT(1),NMS(1),IO(1),JALL(21)
IF(L)GO TO 20
C L=-1 FOR READER, -2=NO TYPE OF NAME LIST.
DO 10 N=1,10
JALL(N)=KT(N)
10 JALL(N+11)=NMS(N)
JALL(11)=K
TYPE 30,K
CALL PUTFIL(NAME)
CALL FASTOU(JALL,21)
CALL FASTOU(IO,K+1)
CALL FINFIL
RETURN
20 CALL GETFIL(NAME)
CALL FASTIN(JALL,21)
K=JALL(11)
TYPE 30,K
30 FORMAT(' TOTAL WDS=',I3,'/350')
CALL FASTIN(IO,K)
DO 40 N=1,10
KT(N)=JALL(N)
40 NMS(N)=JALL(N+11)
IF(L.EQ.-2)RETURN
TYPE 50
TYPE 60,(NMS(N),N=1,10)
50 FORMAT(
1' 0 1 2 3 4 5 6 7
2 8 9')
60 FORMAT(' IDENT. NAMES:'/,10(2XA5))
END
SUBROUTINE CNVT
COMMON/RC/A(4400)
DIMENSION J(10),NM(10),M(600),JALL(21)
EQUIVALENCE(J,JALL,A),(NX,JALL(11)),(NM,JALL(12)),(M,A(2000))
C POINTER LIST, TOTAL WD CNT, NAME LIST.
TYPE 10
10 FORMAT(' TYPE OLD NAME -- '$)
ACCEPT 20,N
20 FORMAT(A5)
TYPE 30
30 FORMAT(' NEW NAME -- '$)
ACCEPT 20,NN
CALL IFILE(1,N)
NX=1
READ(1,40)K,J
40 FORMAT(12I)
50 READ(1,40,END=70)K,K,(M(L),L=NX,NX+K-1)
REREAD 60,L,NM
IF(NM(1))GO TO 70
NX=NX+K
GO TO 50
60 FORMAT(I,10A5)
70 NX=NX-1
CALL RDSAV(J,NM,NX,NN,M,0)
C POINTERS, NAMES, WDCNT, FILE NAME, ARRAY, 0=WRITE
CALL EXIT
END